home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_gen / euphor14.zip / GRAPHICS.E < prev    next >
Text File  |  1996-04-01  |  7KB  |  236 lines
  1.         ----------------------
  2.         -- Graphics & Sound --
  3.         ----------------------
  4.  
  5. --    GRAPHICS MODES --  argument to graphics_mode()
  6.  
  7. -- mode  description
  8. -- ----  -----------
  9. --   -1  restore to original default mode
  10. --    0  40 x 25 text, 16 grey
  11. --    1  40 x 25 text, 16/8 color
  12. --    2  80 x 25 text, 16 grey
  13. --    3  80 x 25 text, 16/8 color
  14. --    4  320 x 200, 4 color
  15. --    5  320 x 200, 4 grey
  16. --    6  640 x 200, BW
  17. --    7  80 x 25 text, BW
  18. --   11  720 x 350, BW  (many video cards are lacking this one)
  19. --   13  320 x 200, 16 color
  20. --   14  640 x 200, 16 color
  21. --   15  640 x 350, BW  (may be 4-color with blinking)
  22. --   16  640 x 350, 4 or 16 color
  23. --   17  640 x 480, BW
  24. --   18  640 x 480, 16 color
  25. --   19  320 x 200, 256 color
  26. --  256  640 x 400, 256 color
  27. --  257  640 x 480, 256 color
  28. --  258  800 x 600, 16 color
  29. --  259  800 x 600, 256 color
  30. --  260  1024 x 768, 16 color
  31. --  261  1024 x 768, 256 color
  32. --  262  1280 x 1024, 16 color (not many cards have 262,263)
  33. --  263  1280 x 1024, 256 color
  34.  
  35. -- COLOR values -- for characters and pixels
  36. global constant BLACK = 0,
  37.         BLUE  = 1,
  38.         GREEN = 2,
  39.         CYAN =  3,
  40.         RED   = 4,
  41.         MAGENTA = 5,
  42.         BROWN = 6,
  43.         WHITE = 7,
  44.         GRAY  = 8,
  45.         BRIGHT_BLUE = 9,
  46.         BRIGHT_GREEN = 10,
  47.         BRIGHT_CYAN = 11,
  48.         BRIGHT_RED = 12,
  49.         BRIGHT_MAGENTA = 13,
  50.         YELLOW = 14,
  51.         BRIGHT_WHITE = 15
  52.  
  53. global constant BLINKING = 16  -- add to color to get blinking text
  54.  
  55.  
  56. -- machine() commands
  57. constant M_SOUND          = 1,
  58.      M_LINE           = 2,
  59.      M_PALETTE        = 3,
  60.      M_PIXEL          = 4,
  61.      M_GRAPHICS_MODE  = 5,
  62.      M_CURSOR         = 6,
  63.      M_WRAP           = 7,
  64.      M_SCROLL         = 8,
  65.      M_SET_T_COLOR    = 9,
  66.      M_SET_B_COLOR    = 10,
  67.      M_POLYGON        = 11,
  68.      M_TEXTROWS       = 12,
  69.      M_VIDEO_CONFIG   = 13,
  70.      M_ELLIPSE        = 18,
  71.      M_GET_PIXEL      = 21,
  72.      M_GET_POSITION   = 25,
  73.      M_ALL_PALETTE    = 27
  74.  
  75. type mode(integer x)
  76.     return (x >= -3 and x <= 19) or (x >= 256 and x <= 263)
  77. end type
  78.  
  79. type color(integer x)
  80.     return x >= 0 and x <= 255
  81. end type
  82.  
  83. type boolean(integer x)
  84.     return x = 0 or x = 1
  85. end type
  86.  
  87. type positive_int(integer x)
  88.     return x >= 1
  89. end type
  90.  
  91. type point(sequence x)
  92.     return length(x) = 2
  93. end type
  94.  
  95. type multi_point(sequence x)
  96.     return length(x) = 2 or length(x) = 3
  97. end type
  98.  
  99. type point_sequence(sequence x)
  100.     return length(x) >= 2
  101. end type
  102.  
  103. global procedure draw_line(color c, point_sequence xyarray)
  104. -- draw a line connecting the 2 or more points
  105. -- in xyarray: {{x1, y1}, {x2, y2}, ...}
  106. -- using a certain color 
  107.     machine_proc(M_LINE, {c, 0, xyarray})
  108. end procedure
  109.  
  110. global procedure polygon(color c,
  111.              boolean fill,
  112.              point_sequence xyarray)
  113. -- draw a polygon using a certain color
  114. -- fill the area if fill is TRUE
  115. -- 3 or more vertices are given in xyarray
  116.     machine_proc(M_POLYGON, {c, fill, xyarray})
  117. end procedure
  118.  
  119. global procedure ellipse(color c, boolean fill, point p1, point p2)
  120. -- draw an ellipse with a certain color that fits in the
  121. -- rectangle defined by diagonal points p1 and p2, i.e. 
  122. -- {x1, y1} and {x2, y2}. The ellipse may be filled or just an outline.   
  123.     machine_proc(M_ELLIPSE, {c, fill, p1, p2})
  124. end procedure
  125.  
  126. global procedure pixel(object c, point p)
  127. -- set the color for a single pixel (when c is an atom)
  128. -- or a horizontal line of pixels (when c is a sequence)
  129.     machine_proc(M_PIXEL, {c, p})
  130. end procedure
  131.  
  132. global function get_pixel(multi_point p)
  133. -- read color number of a single pixel when p is {x, y}, or
  134. -- read a horizontal line of pixels, when p is {x, y, length} 
  135.     return machine_func(M_GET_PIXEL, p)
  136. end function
  137.  
  138. global function graphics_mode(mode m)
  139. -- try to set up a new graphics mode
  140. -- return 0 if successful, non-zero if failed
  141.    return machine_func(M_GRAPHICS_MODE, m)
  142. end function
  143.  
  144. global constant VC_COLOR = 1,
  145.         VC_MODE  = 2,
  146.         VC_LINES = 3,
  147.         VC_COLUMNS = 4,
  148.         VC_XPIXELS = 5,
  149.         VC_YPIXELS = 6,
  150.         VC_NCOLORS = 7,
  151.         VC_PAGES = 8
  152. global function video_config()
  153. -- return sequence of information on video configuration
  154. -- {color?, mode, text lines, text columns, xpixels, ypixels, #colors, pages}
  155.     return machine_func(M_VIDEO_CONFIG, 0)
  156. end function
  157.  
  158. -- cursor styles:
  159. global constant NO_CURSOR       = #2000,
  160.      UNDERLINE_CURSOR       = #0607,
  161.      THICK_UNDERLINE_CURSOR = #0507,
  162.      HALF_BLOCK_CURSOR      = #0407,
  163.      BLOCK_CURSOR           = #0007
  164.      
  165.  
  166. global procedure cursor(integer style)
  167. -- choose a cursor style
  168.     machine_proc(M_CURSOR, style)
  169. end procedure
  170.  
  171. global function get_position()
  172. -- return {line, column} of current cursor position
  173.     return machine_func(M_GET_POSITION, 0)
  174. end function
  175.  
  176. global function text_rows(positive_int rows)
  177.     return machine_func(M_TEXTROWS, rows)
  178. end function
  179.  
  180. global procedure wrap(boolean on)
  181. -- on = 1: characters will wrap at end of long line
  182. -- on = 0: lines will be truncated
  183.     machine_proc(M_WRAP, on)
  184. end procedure
  185.  
  186. global procedure scroll(integer amount, 
  187.             positive_int top_line, 
  188.             positive_int bottom_line)
  189. -- scroll lines of text on screen between top_line and bottom_line
  190. -- amount > 0: scroll text up by amount lines
  191. -- amount < 0: scroll text down by amount lines
  192. -- (had only the first parameter in v1.2)   
  193.     machine_proc(M_SCROLL, {amount, top_line, bottom_line})
  194. end procedure
  195.  
  196. global procedure text_color(color c)
  197. -- set the foreground text color to c - text or graphics modes
  198. -- add 16 to get blinking
  199.     machine_proc(M_SET_T_COLOR, c)
  200. end procedure
  201.  
  202. global procedure bk_color(color c)
  203. -- set the background color to c - text or graphics modes
  204.     machine_proc(M_SET_B_COLOR, c)
  205. end procedure
  206.  
  207. type mixture(sequence s)
  208.     return length(s) = 3 -- {red, green, blue}
  209. end type
  210.  
  211. global function palette(color c, mixture s)
  212. -- choose a new mix of {red, green, blue} to be shown on the screen for
  213. -- color number c. Returns previous mixture as {red, green, blue}.
  214.     return machine_func(M_PALETTE, {c, s})
  215. end function
  216.  
  217. global procedure all_palette(sequence s)
  218. -- s is a sequence of the form: {{r,g,b},{r,g,b}, ...{r,g,b}}
  219. -- that specifies new color intensities for the entire set of
  220. -- colors in the current graphics mode.  
  221.     machine_proc(M_ALL_PALETTE, s)
  222. end procedure
  223.  
  224. -- Sound Effects --
  225.  
  226. type frequency(integer x)
  227.     return x >= 0
  228. end type
  229.  
  230. global procedure sound(frequency f)
  231. -- turn on speaker at frequency f
  232. -- turn off speaker if f is 0
  233.     machine_proc(M_SOUND, f)
  234. end procedure
  235.  
  236.